Whiteline: Alpha/Whiteline Alpha.iso/progtool/modula2/hk_lib/def_mod/queues.mod

Modula Implementation | 1994-09-22 | 21.6 KB | 592 lines

IMPLEMENTATION MODULE  Queues;

(*****************************************************************************)
(* Vor saemtlichen Operationen mit den Queues steht folgende Abfrage:        *)
(*                                                                           *)
(*       IF  ( queue # NIL ) & ( queue^.queueAdr = ADR( queue ))  THEN       *)
(*                                                                           *)
(* Sie garantiert mit ziemlicher Sicherheit, dass die uebergebene Queuevari- *)
(* able einen definierten Wert hat, d.h. mit "Create" erzeugt wurde, und     *)
(* nicht irgendein Pointer ist, der irgendwohin zeigt.                       *)
(* Dazu ist es natuerlich noetig, dass die Queuevariablen auch immer als     *)
(* VAR-Parameter uebergeben werden, denn sonst hat man nur eine Kopie der    *)
(* Queue bzw. des Pointers auf die Queue, und die Adresse der Kopie ist      *)
(* sicherlich eine andere als die der Originalqueue.                         *)
(*                                                                           *)
(* Bei dynamischen Datenstrukturen wie so einer Warteschlange steht man vor  *)
(* dem Problem der Speicherverwaltung. Einerseits sollen die Operationen     *)
(* schnell erfolgen, andererseits soll aber kein Speicher verschwendet wer-  *)
(* den.                                                                      *)
(* Wird fuer die Struktur ein statischer Speicherbereich zu Uebersetzungszeit*)
(* festgelegt, so sind die Queueoperationen sicherlich schnell, da zur Lauf- *)
(* zeit kein Speicher angefordert und freigegeben werden muss. Allerdings    *)
(* kann der einmal festgelegte Speicher in der Groesse nicht mehr veraendert *)
(* werden; d.h. es kann sowohl sein, dass der Speicher zur Laufzeit nicht    *)
(* mehr ausreicht, als auch, dass der Speicher die meiste Zeit unbenutzt     *)
(* bleibt.                                                                   *)
(* Wird hingegen fuer jedes neu in die Queue einzufuegendes Element ein neuer*)
(* Speicherblock angefordert, bzw. beim Herausnehmen des Elements freigege-  *)
(* ben, so wird der Speicher zwar optimal ausgenutzt, aber die Operationen   *)
(* werden entsprechend langsam.                                              *)
(*                                                                           *)
(* Da die Art des Zugriffs bei Queues ( und auch bei Stacks ) genau bekannt  *)
(* ist - naemlich am Ende anfuegen, vom Anfang entfernen, keine anderen Zu-  *)
(* griffe -, kann ein Kompromiss zwischen Geschwindigkeit und Speicheraus-   *)
(* nutzung geschlossen werden:                                               *)
(* Speicher wird nicht fuer jedes neue Element angefordert und freigegeben,  *)
(* sondern immer in Bloecken zu mehreren Elementen, d.h. erst wenn ein Block *)
(* voll ist, wird wieder ein neuer Speicherblock angefordert, und erst wenn  *)
(* ein Block leer ist, wird der Speicher fuer ihn freigegeben. Die Bloecke   *)
(* sind durch eine lineare Liste mit Header verbunden. Im Header sind unter  *)
(* anderem die Adressen des ersten und letzten Blocks enthalten, so dass ohne*)
(* die Liste zu durchsuchen sowohl auf das Frontelement als auch das letzte  *)
(* Element zugegriffen werden kann. Die Verzeigerung ist in folgendem Dia-   *)
(* gramm dargestellt, fuer genauere Informationen sollte der Quelltext durch-*)
(* geackert werden.                                                          *)
(*                                                                           *)
(*       queue                erster Block           letzter Block           *)
(*                                                                           *)
(*          |<----                                                           *)
(*          |     |         ________________        ________________         *)
(*  ________V_____|_       |                |      :                :        *)
(* | queueAdr       |      |   belegt       |      :   noch frei    :        *)
(* |----------------|      |----------------|      :................:        *)
(* :                :   -->| erstes Element |   -->: letztes Element:        *)
(* |----------------|  |   |................|  |   :----------------:        *)
(* | queueFront     |--    :  wieder frei   :  |   :    belegt      :        *)
(* |----------------|      |----------------|  |   |----------------|        *)
(* | frontBlock     |----->| naechsterBlock |-~~~~>|     NIL        |        *)
(* |----------------|      |________________|  |   |________________|        *)
(* | queueTail      |--------------------------          ^                   *)
(* |----------------|                                    |                   *)
(* | tailBlock      |------------------------------------                    *)
(* |________________|                                                        *)
(*                                                                           *)
(*___________________________________________________________________________*)
(*   30-Dez-89 , hk                                                          *)
(*         Beginn                                                            *)
(*   01-Jan-90 , hk                                                          *)
(*         Es werden wirklich Werte in die Queue kopiert ( wie in "Stacks" ),*)
(*         nicht nur Verweise auf sie;                                       *)
(*   24-Feb-90 , hk                                                          *)
(*         voellig neue Block-Speicherverwaltung, automatischer Errorhandler *)
(*         <done> als Prozedurrueckgabe, extra Fehlerrueckgabe mit           *)
(*         "LastQueueResult"                                                 *)
(*****************************************************************************)


FROM   SYSTEM   IMPORT  (* TYPE *)  ADDRESS, BYTE,
                        (* PROC *)  VAL, INLINE, ADR, LONG;

FROM   HEAP     IMPORT  (* PROC *)  Allocate, Deallocate;   (* = Storage ?? *)

IMPORT MEMORY;    (*    (* TYPE *)  CopyProc,
                        (* PROC *)  ClearMem, CopySmallMem, CopyMem;
                   *)

(* ===========================  T Y P E N  ================================= *)

TYPE
      block     = POINTER TO  block;


      Queue     = POINTER TO  QueueInfo;

      QueueInfo = RECORD
         queueAdr     : ADDRESS;          (* Adresse einer Queue          *)
         Copy         : MEMORY.CopyProc;  (* Prozedur fuers Wertekopieren *)
         elemSize     : CARDINAL;         (* Groesse eines Queueelements  *)
         maxElement   : LONGINT;          (* Max. Elementindex im Block   *)
         blockSize    : LONGCARD;         (* Groesse eines Speicherblocks *)
         Elemente     : CARDINAL;         (* Anzahl der Queueelemente     *)
         frontElement : LONGINT;          (* Index des ersten Elements    *)
                                          (* im ersten Block              *)
         queueFront   : ADDRESS;          (* Adr. des ersten Elements     *)
         frontBlock   : block;            (* Adr. des ersten Blocks       *)
         tailElement  : LONGINT;          (* Index des letzten Elementes  *)
                                          (* im letzten Block             *)
         queueTail    : ADDRESS;          (* Adr. des letzten Elements    *)
         tailBlock    : block;            (* Adr. des letzten Blocks      *)
      END;


(* ========================================================================= *)
(* =======================   L O K A L   =================================== *)

VAR
     lastResult   : QueueResult;

     Queuehandler : QueueHandler;
     handlerOn    : BOOLEAN;

(* ------------------------------------------------------------------------- *)

PROCEDURE  emptyQueueHandler ((* EIN/ -- *) proc  : ARRAY OF CHAR;
                              (* EIN/ -- *) qErr  : QueueResult   );
(*T*)
(* nur damit das System nicht abstuerzt, falls aus irgendeinem
   Grund der Handler aktiviert wird, obwohl keiner definiert wurde...
*)
 BEGIN
 END  emptyQueueHandler;

(* ------------------------------------------------------------------------- *)

PROCEDURE  ReleaseBlock ((* EIN/AUS *) VAR queue : Queue );
(*T*)
(* Lokale Hilfsprozedur fuer "Delete","Clear" und "Remove".
   Entfernt ohne Sicherheitsabfrage den ersten Block der Queue
   und gibt dessen Speicherplatz frei.
*)
   VAR  alterBlock : block;

   BEGIN
     WITH  queue^  DO
       alterBlock := frontBlock;   (* Element muss referenzierbar *)
                                   (* bleiben                     *)
       frontBlock := frontBlock^;  (* Element aus der Zeigerkette *)
                                   (* nehmen                      *)
       Deallocate( alterBlock, blockSize );
     END; (* WITH *)
   END  ReleaseBlock;


(* Ende LOKAL ============================================================== *)

PROCEDURE  LastQueueResult ( ): QueueResult;
(*T*)
 BEGIN
   RETURN( lastResult );
 END  LastQueueResult;

(* ------------------------------------------------------------------------- *)

PROCEDURE  AssignQueueHandler ((* EIN/ -- *) handler : QueueHandler );
(*T*)
 BEGIN
   Queuehandler := handler;
   handlerOn    := TRUE;
   lastResult   := queueOk;
 END  AssignQueueHandler;

(* ------------------------------------------------------------------------- *)

PROCEDURE  UnAssignQueueHandler;
(*T*)
 BEGIN
   handlerOn    := FALSE;
   Queuehandler := emptyQueueHandler;    (* sicherheitshalber *)
   lastResult   := queueOk;
 END  UnAssignQueueHandler;

(* ------------------------------------------------------------------------- *)

PROCEDURE  Create ((* EIN/ -- *)     groesse : CARDINAL;
                   (* EIN/ -- *)     blkElem : CARDINAL;
                   (* -- /AUS *) VAR queue   : Queue;
                   (* -- /AUS *) VAR done    : BOOLEAN  );
(*T*)
  CONST  procName = 'Create';

  BEGIN
    IF  groesse = 0  THEN  groesse := 1;  END;
    IF  blkElem = 0  THEN  blkElem := 1;  END;

    done := FALSE;

    Allocate( queue, SIZE( queue^ ));   (* = NEW( queue )  *)

    (* Speicherplatz fuer den Queue-Header *)

    IF  queue # NIL  THEN

       WITH  queue^  DO
         blockSize := LONG( blkElem ) * LONG( groesse ) + LONG( SIZE( block ));

         Allocate( frontBlock, blockSize );

         (* Speicherplatz fuer den ersten Block *)

         IF  frontBlock # NIL   THEN

            frontBlock^ := NIL;   (* auch letzter Block *)

            done        := TRUE;
            lastResult  := queueOk;

            IF  groesse <= 10  THEN
              (* Bei weniger als 10 Bytes ist diese
               * Prozedur schneller, und ueberlappende
               * Speicherbereiche duerfte es hier eigent-
               * lich nicht geben.
               *)
              Copy := MEMORY.CopySmallMem;
            ELSE
              Copy := MEMORY.CopyMem;
            END; (* IF groesse *)

            queueAdr     := ADR( queue ); (* Queue definiert *)
            elemSize     := groesse;
            maxElement   := VAL( LONGINT, blkElem - 1 );
            Elemente     := 0;
            frontElement := 0;
            tailElement  := -1;
            tailBlock    := frontBlock;
            queueFront   := VAL( LONGINT, frontBlock ) + LONG( SIZE( block ));
            queueTail    := queueFront - VAL( ADDRESS, elemSize );

            (* 'tailElement' hat den Index -1, damit bei "Insert"
             * der erste Eintrag im Block nicht uebersprungen
             * wird, da hier zuerst der Index hochgezaehlt wird
             * ( der Index zeigt immer aufs aktuelle Element,
             * und bis jetzt steht ja noch keins drin ).
             * 'queueTail' muss dann natuerlich auch die Adresse
             * VOR dem ersten Element erhalten.
             *)
         END; (* IF frontBlock *)
       END; (* WITH queue^ *)
    END; (* IF queue # NIL *)

    IF  ~done  THEN
      lastResult := noMem;
      queue      := NIL;

      IF  handlerOn  THEN
        Queuehandler( procName, noMem );
      END;
    END; (* IF ~done *)
  END  Create;

(* ------------------------------------------------------------------------- *)

PROCEDURE  Clear ((* EIN/AUS *) VAR queue : Queue;
                  (* -- /AUS *) VAR done  : BOOLEAN );
(*T*)
  CONST procName = 'Clear';

  BEGIN
    IF  ( queue # NIL ) & ( queue^.queueAdr = ADR( queue ))  THEN

      WITH  queue^  DO
        WHILE  frontBlock^ # NIL  DO
          ReleaseBlock( queue );(* Alle Bloecke ausser dem letzten entfernen *)
        END; (* WHILE *)

        Elemente     := 0;
        frontElement := 0;
        queueFront   := VAL( ADDRESS, frontBlock ) + LONG( SIZE( block ));
        tailElement  := -1;
        queueTail    := queueFront - VAL( ADDRESS, elemSize );
      END; (* WITH queue^ *)

      done         := TRUE;
      lastResult   := queueOk;

    ELSE (* <queue> undefiniert *)

      done       := FALSE;
      lastResult := defErr;
      IF  handlerOn  THEN
        Queuehandler( procName, defErr );
      END;
    END; (* IF queue # NIL *)

  END  Clear;

(* ------------------------------------------------------------------------- *)

PROCEDURE  Delete ((* EIN/AUS *) VAR queue : Queue;
                   (* -- /AUS *) VAR done  : BOOLEAN );
(*T*)
   CONST procName = 'Delete';

   BEGIN
     IF  ( queue # NIL ) & ( queue^.queueAdr = ADR( queue ))  THEN
        Clear( queue, done );

        (* Jetzt noch den letzten Block und den
         * Queue-Header entfernen.
         *)

        Deallocate( queue^.frontBlock, SIZE( queue^.blockSize ));
        Deallocate( queue, SIZE( queue^ ));

        queue      := NIL;

        done       := TRUE;
        lastResult := queueOk;

     ELSE  (* <queue> undefiniert *)

        done       := FALSE;
        lastResult := defErr;
        IF  handlerOn  THEN
          Queuehandler( procName, defErr );
        END;
     END; (* IF queue # NIL *)

   END  Delete;

(* ------------------------------------------------------------------------- *)

PROCEDURE  IsEmpty ((* EIN/ -- *) VAR queue : Queue ): BOOLEAN;
(*T*)
  CONST procName = 'IsEmpty';

  BEGIN
    IF  ( queue # NIL ) & ( queue^.queueAdr = ADR( queue ))  THEN
       lastResult := queueOk;

       RETURN( queue^.Elemente = 0 );

    ELSE  (* <queue> undefiniert *)

       lastResult := defErr;
       IF  handlerOn  THEN
         Queuehandler( procName, defErr );
       END;

       RETURN( TRUE);
    END; (* IF queue # NIL *)
  END  IsEmpty;

(* ------------------------------------------------------------------------- *)

PROCEDURE  Length ((* EIN/ -- *) VAR queue : Queue ): CARDINAL;
(*T*)
  CONST procName = 'Length';

  BEGIN
    IF  ( queue # NIL ) & ( queue^.queueAdr = ADR( queue ))  THEN
      lastResult := queueOk;

      RETURN( queue^.Elemente );

    ELSE  (* <queue> undefiniert *)

      lastResult := defErr;
      IF  handlerOn  THEN
        Queuehandler( procName, defErr );
      END;

      RETURN( 0 );
    END; (* IF queue # NIL *)
  END  Length;

(* ------------------------------------------------------------------------- *)

PROCEDURE  Insert ((* EIN/ -- *)     wert  : ARRAY OF BYTE;
                   (* EIN/AUS *) VAR queue : Queue;
                   (* -- /AUS *) VAR done  : BOOLEAN       );
(*T*)
   CONST procName = 'Insert';

   VAR  neuerBlock : block;

   BEGIN
     done       := FALSE;   (* wird nur bei Erfolg geaendert *)
     lastResult := defErr;  (* wird je nach Fehler gesetzt   *)

     WITH queue^  DO
       IF  ( queue # NIL ) & ( queue^.queueAdr = ADR( queue ))  THEN

         IF  elemSize # VAL( CARDINAL, HIGH( wert )) + 1   THEN

           (* Der Speicherplatz eines Feldes von BYTES laesst
            * sich natuerlich aus der Obergrenze des Feldes
            * berechnen. Hier stimmt der Speicherbedarf nicht
            * mit der Definition ueberein.
            *)
           lastResult := sizeErr;

         ELSE (* Speicherplatz stimmt *)

           IF  tailElement < maxElement  THEN
             (* Fuer das neue Element ist noch Platz im Block *)

             INC( tailElement );
             INC( queueTail, elemSize );

             done := TRUE;

           ELSE (* neuer Block faellig *)

             (* Der Speicher fuer den neuen Block
              * wird beschafft.
              *)

             Allocate( neuerBlock, blockSize );

             IF  neuerBlock = NIL  THEN

               lastResult:= noMem;  (* Kein Speicher mehr *)
             ELSE (* alles klar *)

               neuerBlock^ := NIL;        (* Ende der Liste              *)
               tailBlock^  := neuerBlock; (* an bisher letzten anhaengen *)
               tailBlock   := neuerBlock; (* als neuen letzten merken    *)

               tailElement := 0;
               queueTail   := VAL( LONGINT, tailBlock ) + LONG( SIZE( block ));

               (* tailElement jetzt nicht -1, da ja gleich ein
                * Wert in den neuen Block kopiert wird.
                *)
               done := TRUE;

             END; (* IF neuerBlock *)
           END; (* IF tailElement *)
         END; (* IF elemSize *)
       END; (* IF queue # NIL *)

       IF  done  THEN
         Copy( ADR( wert ), queueTail, elemSize );
         INC( Elemente );
         lastResult  := queueOk;

       ELSE (* Fehler aufgetreten *)

         IF  handlerOn  THEN
           Queuehandler( procName, lastResult );
         END;
       END; (* IF done *)

     END; (* WITH queue^ *)


   END  Insert;

(* ------------------------------------------------------------------------- *)

PROCEDURE  Look ((* EIN/ -- *) VAR queue : Queue;
                 (* -- /AUS *) VAR wert  : ARRAY OF BYTE;
                 (* -- /AUS *) VAR done  : BOOLEAN       );
(*T*)
   CONST procName = 'Look';

   BEGIN
     done       := FALSE;
     lastResult := defErr;

     WITH queue^  DO
       IF  ( queue # NIL ) & ( queue^.queueAdr = ADR(queue ))  THEN

         IF  elemSize # VAL( CARDINAL, HIGH( wert )) + 1   THEN
           lastResult := sizeErr;

         ELSE (* Speicherplatz stimmt *)

           IF   Elemente = 0   THEN
             lastResult := queueEmpty;  (* nix da *)

           ELSE  (* Queue nicht leer *)
             done       := TRUE;
             lastResult := queueOk;

             Copy( queueFront, ADR( wert ), elemSize );
           END; (* IF Elemente *)
         END; (* IF elemSize *)
       END; (* IF queue # NIL ... *)

       IF  ~done  THEN
         (* Zur Sicherheit den gelieferten
          * ( nicht vorhandenen ) Wert init.
          *)
         MEMORY.ClearMem( ADR( wert ), HIGH( wert ) + 1 );

         IF  handlerOn  THEN
           Queuehandler( procName, lastResult );
         END;
       END; (* IF ~done *)
     END; (* WITH queue^ *)

   END  Look;

(* ------------------------------------------------------------------------- *)

PROCEDURE  Remove ((* EIN/AUS *) VAR queue : Queue;
                   (* -- /AUS *) VAR wert  : ARRAY OF BYTE;
                   (* -- /AUS *) VAR done  : BOOLEAN       );
(*T*)
   CONST procName = 'Remove';

   BEGIN
     done       := FALSE;
     lastResult := defErr;

     IF  ( queue # NIL ) & ( queue^.queueAdr = ADR( queue ))  THEN

       WITH queue^  DO
         IF  elemSize # VAL( CARDINAL, HIGH( wert )) + 1   THEN
           lastResult := sizeErr;

         ELSE (* Speicherplatz stimmt *)

           IF   Elemente = 0   THEN
             lastResult := queueEmpty;

           ELSE  (* <queue> nicht leer *)
             done       := TRUE;
             lastResult := queueOk;

             Copy( queueFront, ADR( wert ), elemSize );

             DEC( Elemente );

             IF  ( Elemente > 0 ) & ( frontElement < maxElement )  THEN

               (* Wenn noch ein Element in der Queue ist, und das
                * naechste Element noch innerhalb dieses Blocks ist,
                * koennen Index und Adresse einfach hochgezaehlt werden.
                *)

               INC( frontElement );
               INC( queueFront, elemSize );

             ELSE (* <queue> leer oder lediglich vorderer Block leer *)

               IF frontBlock^ # NIL  THEN

                 (* Wenn lediglich der vordere Block leer ist,
                  * aber nicht die Queue - d.h. es existieren noch
                  * weitere Bloecke -, den vorderen Block entfernen.
                  * Der Zeiger auf das letzte Element bleibt erhalten.
                  *)
                 ReleaseBlock ( queue );

               ELSE  (* <queue> ist leer *)

                 tailElement := -1;
                 queueTail   :=   VAL( ADDRESS, frontBlock )
                                - VAL( ADDRESS, elemSize )
                                + LONG( SIZE( block ));
               END;

               (* Das Frontelement beginnt auf jeden Fall am
                * Anfang des 'frontBlock's, egal ob in der Queue
                * noch was drin ist.
                *)
               frontElement := 0;
               queueFront   := VAL(ADDRESS, frontBlock) + LONG( SIZE( block ));

             END; (* IF ( Elemente > 0 )... *)

           END; (* IF Elemente *)
         END; (* IF elemSize *)
       END; (* WITH queue^ *)
     END; (* IF queue # NIL ... *)

     IF  ~done  THEN
       MEMORY.ClearMem( ADR( wert ), HIGH( wert ) + 1 );

       IF  handlerOn  THEN
         Queuehandler( procName, lastResult );
       END;
     END; (* IF ~done *)


   END  Remove;


END  Queues.